home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / DELIB.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-07  |  3KB  |  96 lines
  1.  
  2. Program DeLibrary;
  3.  
  4. { DeLibrary for Turbo Pascal
  5.   Version 1.00
  6.   By Bela Lubkin
  7.  
  8.   This program extracts all the files from a library.  It does only the bare
  9.   minimum of error checking.  It does not provide any options.  The only thing
  10.   it does is split library files.  If you have any interest in using
  11.   libraries, you are directed to:
  12.     For CP/M-80: LU310.BIN (LU310.COM) in DL2 of SIGCPM, GO PCS-47 or R SIGCPM
  13.     For CP/M-86: LU8645.BIN (LU8645.CMD) in DL9 of SIGCPM
  14.     For MS-DOS:  LU8643.BIN (LU8643.EXE) in DL6 of IBM PC SIG, GO PCS-131 or
  15.                  R IBMSIG.
  16.   (Do a S/KEY:LIBRARY/DES to find all associated documents and to possibly
  17.    find newer versions)
  18. }
  19.  
  20.   Const
  21.     BufSecs=200;   { Number of 128 byte sectors to allocate for buffer }
  22.  
  23.   Type
  24.     Sector=Array [0..127] Of Byte;
  25.     String80=String[80];
  26.     FileName=String[20];
  27.  
  28.   Var
  29.     LibFile,OutFile: File;
  30.     LibName,OutName: FileName;
  31.     DirBuffer: Sector;
  32.     I,J,Offset,DirLength,FirstSec,NumSecs,Secs: Integer;
  33.     Buffer: Array [1..BufSecs] Of Sector;
  34.  
  35.   Procedure Error(S: String80);
  36.  
  37.     Begin
  38.       Write(S);
  39.       {$I-} Close(LibFile); {$I+}
  40.       Halt;
  41.     End;
  42.  
  43.   Begin
  44.     Write('Enter library file name: ');
  45.     ReadLn(LibName);
  46.     If Pos('.',LibName)=0 Then LibName:=LibName+'.LBR';
  47.     Assign(LibFile,LibName);
  48.     {$I-} Reset(LibFile); {$I+}
  49.     If IOResult<>0 Then Error('Library file not found');
  50.     BlockRead(LibFile,DirBuffer,1);
  51.     If DirBuffer[0]<>0 Then Error('Not a library file');
  52.     For I:=1 To 11 Do If DirBuffer[I]<>32 Then Error('Not a library file');
  53.     If (DirBuffer[12]<>0) Or (DirBuffer[13]<>0) Then
  54.       Error('Not a library file');
  55.     DirLength:=DirBuffer[14]+256*DirBuffer[15];
  56.     If DirLength=0 Then Error('Not a library file');
  57.     For I:=1 To DirLength*4-1 Do
  58.      Begin
  59.       Offset:=32*(I Mod 4);
  60.       If Offset=0 Then
  61.        Begin
  62.         Seek(LibFile,I Div 4);
  63.         BlockRead(LibFile,DirBuffer,1);
  64.        End;
  65.       If DirBuffer[Offset]=$FF Then Error('Done!')
  66.       Else If DirBuffer[Offset]=0 Then
  67.        Begin
  68.         OutName:='';
  69.         For J:=1 To 8 Do If DirBuffer[Offset+J]<>32 Then
  70.           OutName:=OutName+Chr(DirBuffer[Offset+J]);
  71.         OutName:=OutName+'.';
  72.         For J:=9 To 11 Do If DirBuffer[Offset+J]<>32 Then
  73.           OutName:=OutName+Chr(DirBuffer[Offset+J]);
  74.         WriteLn('Extracting file ',OutName);
  75.         Assign(OutFile,OutName);
  76.         {$I-} Rewrite(OutFile); {$I+}
  77.         If IOResult<>0 Then Error('Could not create '+OutName);
  78.         FirstSec:=DirBuffer[Offset+12]+256*DirBuffer[Offset+13];
  79.         NumSecs:=DirBuffer[Offset+14]+256*DirBuffer[Offset+15];
  80.         Seek(LibFile,FirstSec);
  81.         While NumSecs>0 Do
  82.          Begin
  83.           If BufSecs<NumSecs Then Secs:=BufSecs
  84.           Else Secs:=NumSecs;
  85.           BlockRead(LibFile,Buffer,Secs);
  86.           BlockWrite(OutFile,Buffer,Secs);
  87.           NumSecs:=NumSecs-Secs;
  88.          End;
  89.         Close(OutFile);
  90.        End;
  91.      End;
  92.     Error('Done!');
  93.   End.
  94.  
  95.  
  96. Key <ENTER> to continue: